home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v9n21.arc / PRISM.PAS < prev    next >
Pascal/Delphi Source File  |  1990-11-17  |  12KB  |  295 lines
  1. {
  2.  ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
  3.  █                                                                         █
  4.  █        TITLE :      PRISM.EXE                                           █
  5.  █      PURPOSE :      Video Palette Editor.                               █
  6.  █       AUTHOR :      David Gerrold, CompuServe ID:  70307,544            █
  7.  █  _____________________________________________________________________  █
  8.  █                                                                         █
  9.  █   Written in Turbo Pascal, Version 5.5,                                 █
  10.  █   with routines from TurboPower, Object Professional.                   █
  11.  █                                                                         █
  12.  █   Turbo Pascal is a product of Borland International.                   █
  13.  █   Object Professional is a product of TurboPower Software.              █
  14.  █  _____________________________________________________________________  █
  15.  █                                                                         █
  16.  █   This is not public domain software.                                   █
  17.  █   This version of PRISM is copyright (c) 1990, Ziff Communications Co.  █
  18.  █                                                                         █
  19.  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
  20.                                                                             }
  21. { Compiler Directives ===================================================== }
  22.  
  23. {$A-}    {Switch word alignment off, necessary for cloning}
  24. {$R-}    {Range checking off}
  25. {$B-}    {Boolean complete evaluation off}
  26. {$S-}    {Stack checking off}
  27. {$I-}    {I/O checking off}
  28. {$N+,E+} {Simulate numeric coprocessor}
  29. {$M 16384,0,327680} {stack and heap}
  30. {$V-}    {Variable range checking off}
  31.  
  32. { Name ==================================================================== }
  33.  
  34. PROGRAM Prism;
  35.  
  36. { ========================================================================= }
  37. { Uses ==================================================================== }
  38.  
  39. USES
  40. { Turbo Pascal 5.5 Units }
  41.   Dos,
  42.  
  43. { Object Professional Units }
  44.   OpClone,
  45.   OpCmd,
  46.   OpColor,
  47.   OpCrt,
  48.   OpDir,
  49.   OpDos,
  50.   OpEdit,
  51.   OpEntry,
  52.   OpErrHan,
  53.   OpFrame,
  54.   OpHelp,
  55.   OpInt,
  56.   OpMenu,
  57.   OpMouse,
  58.   OpPick,
  59.   OpRoot,
  60.   OpStrDev,
  61.   OpString,
  62.   OpWindow,
  63.  
  64. { DgUnits }
  65.   DgCrt,
  66.   DgDec,
  67.   DgDialog,
  68.   DgFile,
  69.   DgMath,
  70.   DgParam,
  71.   DgSound,
  72.   DgStr,
  73.   DgWryte;
  74.  
  75. { ========================================================================= }
  76. { Clone Declarations ====================================================== }
  77.  
  78. CONST
  79.   { start of installation area }
  80.   Id : string [30]      = 'Copyright 1990, David Gerrold';
  81.  
  82.   { configuration data }
  83.   SfxFlag         : boolean = true;              { sound effects on }
  84.   MouseSpeed      : integer = 2;                 { fast speed }
  85.   DissolveDelay   : integer = 2;                 { 12 steps to dissolve }
  86.  
  87.   { end of installation area }
  88.   CfgEnd : byte = 0;
  89.  
  90. VAR
  91.   { for resetting defaults in a config file: }
  92.   Block : array [0..10] of byte absolute SfxFlag;
  93.   StoreSfxFlag : boolean;
  94.   StoreMouseSpeed : integer;
  95.   StoreDissolveDelay : integer;
  96.  
  97.   CloneArranger : Cloner;                        { Clone Object }
  98.   PrismHelp     : ScrollingHelpWindow;           { Help Object }
  99.  
  100.  
  101. { ========================================================================= }
  102. { Palette Object Declarations ============================================= }
  103.  
  104. TYPE
  105.   VgaRegisterOb = Object
  106.     ColorNumber : byte;                          { 0..15 }
  107.     EgaReg      : byte;                          { ega register 0..63 }
  108.     ColorValues : record case boolean of
  109.       true  : (Saturation, R, G, B, Intensity : byte);
  110.       false : (ValArray : array [0..4] of byte);
  111.       end;
  112.     Rreal,
  113.     Greal,
  114.     Breal       : real;                          { for stepping }
  115.     Rstep,
  116.     Gstep,
  117.     Bstep       : real;                          { how big a step }
  118.  
  119.     Procedure Accept (Num, Rval, Gval, Bval : byte);  { accept color vals }
  120.     Procedure Get (Color : byte);                { read register values }
  121.     Procedure Put;                               { poke register values }
  122.     Procedure GetSaturation (Color : byte);      { get Saturation steps }
  123.     Procedure GetIntensity (Color : byte);       { get Intensity steps }
  124.     Procedure SetSaturation (Vector : integer);  { Saturation up or down }
  125.     Procedure SetIntensity (Vector : integer);   { Intensity up or down }
  126.     end;
  127.  
  128.   VgaPaletteOb = Object
  129.     P : VgaRegArray;                             { array [0..16, 1 ..3] }
  130.  
  131.     { undo variables }
  132.     MaxYank  : integer;
  133.     Ctr      : integer;
  134.     Stack    : array [0..15] of VgaRegArray;
  135.  
  136.     { undo procedures }
  137.     Procedure Init;                              { Gets }
  138.     Procedure Push;                              { store for undo }
  139.     Procedure Pop (VAR Palette : VgaRegArray);   { undo }
  140.  
  141.     { palette procedures }
  142.     Procedure Get;                               { read register values }
  143.     Procedure Put;                               { poke register values }
  144.     Procedure Swap (Source, Target : byte);      { swap two colors }
  145.     Procedure Dupe (Source, Target : byte);      { duplicate a color }
  146.     Procedure SetRGB (ColorNumber, Color, Value : byte);
  147.                                                  { poke a color value }
  148.     Procedure DissolveTo (NewPal : VgaRegArray); { change to a new palette }
  149.     end;
  150.  
  151.   PendOb = Object
  152.     Status : integer;                            { status }
  153.  
  154.     Procedure Init;                              { status := -1 }
  155.     Procedure Draw;                              { display msg }
  156.     Procedure SetStatus (NewStatus : integer);   { update msg }
  157.     Procedure Erase;                             { erase msg }
  158.     end;
  159.  
  160. VAR
  161.   Pal            : VgaPaletteOb;                 { active object }
  162.   Pending        : PendOb;                       { pending window }
  163.  
  164. { ========================================================================= }
  165. { Screen Declarations ===================================================== }
  166.  
  167. CONST
  168.   PaletteFileName : string = '';                 { read/write to file }
  169.  
  170.   NormalMouseChar  = #04;
  171.   MouseChar : Char = NormalMouseChar;            { mouse cursor }
  172.  
  173.   BxChar         = #219;                         { for drawing boxes }
  174.   SliderChar     = #15;                          { sliders }
  175.   SaturationChar = #31;                          { saturation marker }
  176.   IntensityChar  = #30;                          { intensity marker }
  177.   LineChar       = #196;                         { slider lines }
  178.   FrameChar      = #205;                         { slider frame }
  179.  
  180.   MeterString1 : string [65] = #199 +
  181.                                #196#196#196#196#196#196#196#196 +
  182.                                #196#196#196#196#196#196#196#196 +
  183.                                #196#196#196#196#196#196#196#196 +
  184.                                #196#196#196#196#196#196#196#196 +
  185.                                #196#196#196#196#196#196#196#196 +
  186.                                #196#196#196#196#196#196#196#196 +
  187.                                #196#196#196#196#196#196#196#196 +
  188.                                #196#196#196#196#196#196#196 +
  189.                                #182;
  190.  
  191.   MeterString2 : string [66] = #199 +
  192.                                #205#205#205#205#205#205#205#205 +
  193.                                #205#205#205#205#205#205#205#205 +
  194.                                #205#205#205#205#205#205#205#205 +
  195.                                #205#205#205#205#205#205#205#205 +
  196.                                #205#205#205#205#205#205#205#205 +
  197.                                #205#205#205#205#205#205#205#205 +
  198.                                #205#205#205#205#205#205#205#205 +
  199.                                #205#205#205#205#205#205#205 +
  200.                                #182;
  201.   SaturationLine = 18;
  202.   RedLine        = SaturationLine + 1;
  203.   GreenLine      = RedLine + 1;
  204.   BlueLine       = GreenLine + 1;
  205.   IntensityLine  = BlueLine + 1;
  206.  
  207.   FadeRateArray  : array [0..6] of byte = (0,6,12,18,24,30,36);
  208.  
  209.  
  210. { ========================================================================= }
  211. { Program Declarations ==================================================== }
  212.  
  213. VAR
  214.   ExitFlag       : boolean;                      { leave program? }
  215.  
  216.   LastColor,                                     { last active color }
  217.   CurrentColor   : integer;                      { active color }
  218.   LastSliderOption,                              { last active slider }
  219.   SliderOption   : integer;                      { active slider }
  220.  
  221.   MouseStoreTime : longint;                      { for double click }
  222.  
  223.   SelectColor    : byte;                         { for swapping & duping }
  224.   VgaReg         : VgaRegisterOb;                { holder for Sat & Int }
  225.  
  226. VAR
  227.   Status : Word;                                 { used by menu system }
  228.   M      : Menu;                                 { menu system }
  229.   H      : RawWindow;                            { item help window }
  230.   CW     : RawWindow;                            { colophon window }
  231.  
  232. { Linking ================================================================= }
  233.  
  234. {$L Prism.Obj }
  235. PROCEDURE HelpText ; external;                   { help text }
  236.  
  237. {$I PrisMenu.Inc }                               { menu & help system }
  238. {$I Prism.Inc }                                  { actual palette editor }
  239.  
  240. { ========================================================================= }
  241. { Main  =================================================================== }
  242.  
  243. BEGIN
  244.   { Program can't clone unless it knows itself. }
  245.   SetProgramName ('Prism', 1.0);                 { PC-Mag version 1.0 }
  246.  
  247.   if CurrentDisplay < VGA then                   { check for VGA }
  248.     NoVga;                                       { halt }
  249.   if DefColorChoice = ForceMono then             { no /bw param }
  250.     NoBw;                                        { halt }
  251.  
  252.   if ExistAnyFile (ConfigFileName) then begin
  253.     Reset (ConfigFile, sizeof (Block));
  254.     BlockRead (ConfigFile, Block, 1);
  255.     Close (ConfigFile);
  256.     end;
  257.  
  258.   SfxOptions := ord (SfxFlag);                   { sound cues only }
  259.   StoreSfxFlag := SfxFlag;                       { store for comparisons }
  260.   StoreMouseSpeed := MouseSpeed;
  261.   StoreDissolveDelay := DissolveDelay;
  262.  
  263.   FadeRate := FadeRateArray [DissolveDelay];     { Set FadeRate }
  264.   DoBoxes;                                       { set msg appearance }
  265.  
  266.   if ParamCount = 1 then
  267.     LoadNewPalette                               { load a palette }
  268.   else
  269.     RunEditor;                                   { edit a palette }
  270.  
  271.   StoreVgaPal := Pal.P;                          { reset stored system pal }
  272. { 
  273.   StoreVgaPal holds the palette that was running on the system when 
  274.   the program booted.  When the system goes to restore the previous  
  275.   palette, it will now reset it to the user's chosen (or redefined) 
  276.   set of colors.
  277.  
  278.   Because DgCrt.FadeStart sets a flag, the exit procedure will automatically
  279.   fade out and fade back in to the saved DOS screen.
  280. } 
  281. END.
  282.  
  283. { ========================================================================= }
  284. { ========================================================================= }
  285.  
  286. VERSION HISTORY:
  287.  
  288.   9009.18
  289.     First release version (1.0) completed.
  290.  
  291. { ========================================================================= }
  292. { ========================================================================= }
  293.  
  294.  
  295.